(* Yoann Padioleau
 *
 * Copyright (C) 2021, 2022 r2c
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * LICENSE for more details.
 *)
open Common
open Fpath_.Operators
open OCaml (* map_of_string, map_of_option, ... *)
open AST_generic
module G = AST_generic
module B = Ast_generic_v1_t
module H = AST_generic_helpers

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* Convert the generic AST to the exported AST_generic_v1.atd type.
 *
 * This file is mostly a copy paste of Map_AST.ml, which itself
 * was mostly autogenerated by ocamltarzan.
 * alt: define a ppx deriving plugin to autogenerate the mapper
 * (or deriving map good enough?)
 *
 * I've tagged with 'new' recent AST_generic constructs not present
 * in AST_generic_v1.atd.
 *)

(*****************************************************************************)
(* Errors *)
(*****************************************************************************)

(* alt: we could allow to dump the generic AST of a pattern, but
 * let's make it simple for now and just support the dump of target files
 *)
exception SemgrepConstruct of Tok.t

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)
let map_id x = x
let map_of_ref f x = f !x
let fk = Tok.unsafe_fake_tok ""

let error any =
  let v = Meta_AST.vof_any any in
  let s = OCaml.string_of_v v in
  failwith (spf "TODO: %s" s)

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

(* Inaccurate. Used so that we can keep backwards compatibility as we add more
 * information to the generic AST. *)
let ident_of_name = function
  | Id (id, _)
  | IdQualified { name_last = id, _; _ } ->
      id

(*****************************************************************************)
(* Mapper *)
(*****************************************************************************)

let map_token_location { Tok.str; pos = { bytepos; line; column; file; _ } } =
  { B.str; charpos = bytepos; line; column; filename = !!file }

(* generated by ocamltarzan with: camlp4o -o /tmp/yyy.ml -I pa/ pa_type_conv.cmo pa_map.cmo  pr_o.cmo /tmp/xxx.ml  *)

let map_tok v : B.token =
  match v with
  | Tok.FakeTok (s, _) -> `FakeTok s
  | Tok.OriginTok loc ->
      let loc = map_token_location loc in
      `OriginTok loc
  | _ -> error (Tk v)

let map_wrap _of_a (v1, v2) =
  let v1 = _of_a v1 and v2 = map_tok v2 in
  (v1, v2)

let map_bracket of_a (v1, v2, v3) =
  let v1 = map_tok v1 and v2 = of_a v2 and v3 = map_tok v3 in
  (v1, v2, v3)

let map_ident (v : ident) : B.ident = map_wrap map_of_string v
let map_dotted_ident v : B.dotted_ident = map_of_list map_ident v

let map_module_name = function
  | FileName v1 ->
      let v1 = map_wrap map_of_string v1 in
      `FileName v1
  | DottedName v1 ->
      let v1 = map_dotted_ident v1 in
      `DottedName v1

let rec map_resolved_name (v1, v2) =
  let v1 = map_resolved_name_kind v1 in
  let v2 = AST_generic.SId.to_int v2 in
  (v1, v2)

and map_canonical_name v1 =
  map_of_list (fun x -> (map_of_string x, map_tok fk)) v1

and map_resolved_name_kind = function
  | LocalVar -> `Local
  | Parameter -> `Param
  | EnclosedVar -> `OtherResolvedNameKind "EnclosedVar"
  | Global -> `Global
  | ImportedEntity v1 ->
      let v1 = map_canonical_name v1 in
      `ImportedEntity v1
  | ImportedModule v1 ->
      let v1 = map_canonical_name v1 in
      `ImportedModule (`DottedName v1)
  | Macro -> `OtherResolvedNameKind "Macro"
  | EnumConstant -> `OtherResolvedNameKind "EnumConstant"
  | TypeName -> `OtherResolvedNameKind "TypeName"
  | GlobalName (v1, _v2less) ->
      let v1 = map_canonical_name v1 in
      `ImportedEntity v1

and map_id_info x =
  match x with
  | {
   G.id_resolved = v_id_resolved;
   id_resolved_alternatives = _not_available_in_v1_;
   id_type = v_id_type;
   id_svalue = v3;
   id_flags = _not_available_in_v1;
  } ->
      let v3 = map_of_ref (map_of_option map_svalue) v3 in
      let v_id_type = map_of_ref (map_of_option map_type_) v_id_type in
      let v_id_resolved =
        map_of_ref (map_of_option map_resolved_name) v_id_resolved
      in
      { B.id_resolved = v_id_resolved; id_type = v_id_type; id_svalue = v3 }

and map_xml
    { G.xml_kind = v_xml_tag; xml_attrs = v_xml_attrs; xml_body = v_xml_body } :
    B.xml =
  let v_xml_body = map_of_list map_xml_body v_xml_body in
  let v_xml_attrs = map_of_list map_xml_attribute v_xml_attrs in
  let v_xml_tag = map_xml_kind v_xml_tag in
  { B.xml_kind = v_xml_tag; xml_attrs = v_xml_attrs; xml_body = v_xml_body }

and map_xml_kind = function
  | XmlClassic (v0, v1, v2, v3) ->
      let v0 = map_tok v0 in
      (* TODO Update the AST JSON output to include a name here. *)
      let v1 = ident_of_name v1 |> map_ident in
      let v2 = map_tok v2 in
      let v3 = map_tok v3 in
      `XmlClassic (v0, v1, v2, v3)
  | XmlSingleton (v0, v1, v2) ->
      let v0 = map_tok v0 in
      (* TODO Update the AST JSON output to include a name here. *)
      let v1 = ident_of_name v1 |> map_ident in
      let v2 = map_tok v2 in
      `XmlSingleton (v0, v1, v2)
  | XmlFragment (v1, v2) ->
      let v1 = map_tok v1 in
      let v2 = map_tok v2 in
      `XmlFragment (v1, v2)

and map_xml_attribute (x : G.xml_attribute) : B.xml_attribute =
  match x with
  | XmlAttr (v1, t, v2) ->
      let v1 = map_ident v1 and t = map_tok t and v2 = map_xml_attr v2 in
      `XmlAttr (v1, t, v2)
  | XmlAttrExpr v ->
      let v = map_bracket map_expr v in
      `XmlAttrExpr v
  | XmlEllipsis v -> raise (SemgrepConstruct v)

and map_xml_attr v = map_expr v

and map_xml_body = function
  | XmlText v1 ->
      let v1 = map_wrap map_of_string v1 in
      `XmlText v1
  | XmlExpr v1 ->
      let v1 = map_bracket (map_of_option map_expr) v1 in
      `XmlExpr v1
  | XmlXml v1 ->
      let v1 = map_xml v1 in
      `XmlXml v1

and map_name = function
  | Id (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_id_info v2 in
      `Id (v1, v2)
  | IdQualified v1 ->
      let v1 = map_qualified_info v1 in
      `IdQualified v1

and map_qualified_info { name_last; name_middle; name_top; name_info } =
  let name_last =
    match name_last with
    | v1, v2 ->
        let v1 = map_ident v1 in
        let v2 = map_of_option map_type_arguments v2 in
        (v1, v2)
  in
  let name_middle = map_of_option map_qualifier name_middle in
  let name_top = map_of_option map_tok name_top in
  let name_info = map_id_info name_info in
  { B.name_last; name_middle; name_top; name_info }

and map_qualifier = function
  | QDots v1 ->
      let v1 =
        map_of_list
          (fun (v1, v2) ->
            let v1 = map_ident v1 in
            let v2 = map_of_option map_type_arguments v2 in
            (v1, v2))
          v1
      in
      `QDots v1
  | QExpr (e, t) ->
      let e = map_expr e in
      let t = map_tok t in
      `QExpr (e, t)

and map_expr x : B.expr =
  match x.e with
  | N v1 ->
      let v1 = map_name v1 in
      `N v1
  | DotAccessEllipsis (_v1, v2) -> raise (SemgrepConstruct v2)
  | DisjExpr (_v1, _v2) -> raise (SemgrepConstruct fk)
  | L v1 ->
      let v1 = map_literal v1 in
      `L v1
  | Container (v1, v2) ->
      let v1 = map_container_operator v1
      and v2 = map_bracket (map_of_list map_expr) v2 in
      `Container (v1, v2)
  | Comprehension (v1, v2) ->
      let v1 = map_container_operator v1 in
      let v2 = map_bracket map_comprehension v2 in
      `Comprehension (v1, v2)
  | Record v1 ->
      let v1 = map_bracket (map_of_list map_field) v1 in
      `Record v1
  | Constructor (v1, v2) ->
      let v1 = map_name v1 in
      let v2 = map_bracket (map_of_list map_expr) v2 in
      `Constructor (v1, v2)
  | RegexpTemplate ((l, v1, _r), _opt) ->
      (* new: TODO in next version: support regexp templates found in Ruby
         like /hello #{name}/ *)
      `L
        (match v1 with
        | { e = G.L (G.String (l, x, r)); _ } ->
            let l = map_tok l in
            let r = map_tok r in
            let static_regexp = map_wrap map_of_string x in
            `Regexp ((l, static_regexp, r), None)
        | _dropped_template ->
            let fk' = map_tok fk in
            `Regexp ((fk', ("", map_tok l), fk'), None))
  | Lambda v1 ->
      let v1 = map_function_definition v1 in
      `Lambda v1
  | AnonClass v1 ->
      let v1 = map_class_definition v1 in
      `AnonClass v1
  | Xml v1 ->
      let v1 = map_xml v1 in
      `Xml v1
  | IdSpecial v1 ->
      let v1 = map_wrap map_special v1 in
      `IdSpecial v1
  | Call (v1, v2) ->
      let v1 = map_expr v1 and v2 = map_arguments v2 in
      `Call (v1, v2)
  | New (v1, v2, _v3, v4) ->
      let v1 = map_tok v1 in
      let v2 = map_type_ v2 in
      let v4 = map_arguments v4 in
      `New (v1, v2, v4)
  | Assign (v1, v2, v3) ->
      let v1 = map_expr v1 and v2 = map_tok v2 and v3 = map_expr v3 in
      `Assign (v1, v2, v3)
  | AssignOp (v1, v2, v3) ->
      let v1 = map_expr v1
      and v2 = map_wrap map_arithmetic_operator v2
      and v3 = map_expr v3 in
      `AssignOp (v1, v2, v3)
  | LetPattern (v1, v2) ->
      let v1 = map_pattern v1 and v2 = map_expr v2 in
      `LetPattern (v1, v2)
  | DotAccess (v1, t, v2) ->
      let v1 = map_expr v1 and t = map_tok t and v2 = map_field_name v2 in
      `DotAccess (v1, t, v2)
  | ArrayAccess (v1, v2) ->
      let v1 = map_expr v1 and v2 = map_bracket map_expr v2 in
      `ArrayAccess (v1, v2)
  | SliceAccess (v1, v2) ->
      let f = map_of_option map_expr in
      let v1 = map_expr v1 and v2 = map_bracket (OCaml.map_of_all3 f f f) v2 in
      `SliceAccess (v1, v2)
  | Conditional (v1, v2, v3) ->
      let v1 = map_expr v1 and v2 = map_expr v2 and v3 = map_expr v3 in
      `Conditional (v1, v2, v3)
  | TypedMetavar (_v1, v2, _v3) -> raise (SemgrepConstruct v2)
  | Yield (t, v1, v2) ->
      let t = map_tok t in
      let v1 = map_of_option map_expr v1 and v2 = map_of_bool v2 in
      `Yield (t, v1, v2)
  | Await (t, v1) ->
      let t = map_tok t in
      let v1 = map_expr v1 in
      `Await (t, v1)
  | Cast (v1, _t, v2) ->
      let v1 = map_type_ v1 and v2 = map_expr v2 in
      `Cast (v1, v2)
  | Seq v1 ->
      let v1 = map_of_list map_expr v1 in
      `Seq v1
  | Ref (t, v1) ->
      let t = map_tok t in
      let v1 = map_expr v1 in
      `Ref (t, v1)
  | DeRef (t, v1) ->
      let t = map_tok t in
      let v1 = map_expr v1 in
      `DeRef (t, v1)
  (* new: *)
  | Alias ((s, tk), v2) ->
      let tk = map_tok tk in
      let v2 = map_expr v2 in
      `OtherExpr (("Alias", tk), [ `I (s, tk); `E v2 ])
  | Ellipsis v1 ->
      let v1 = map_tok v1 in
      `Ellipsis v1
  | DeepEllipsis (v1, _, _) -> raise (SemgrepConstruct v1)
  | LocalImportAll _ -> failwith "TODO"
  | OtherExpr (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherExpr (v1, v2)
  | StmtExpr v1 ->
      let v1 = map_stmt v1 in
      `StmtExpr v1
  | RawExpr x ->
      let first_tok, _last_tok = Raw_tree.unsafe_loc x in
      `OtherExpr (("RawExpr", map_tok first_tok), [])

and map_comprehension (v1, v2) =
  let v1 = map_expr v1 in
  let v2 = map_of_list map_for_or_if_comp v2 in
  (v1, v2)

and map_for_or_if_comp = function
  | CompFor (v1, v2, v3, v4) ->
      let v1 = map_tok v1 in
      let v2 = map_pattern v2 in
      let v3 = map_tok v3 in
      let v4 = map_expr v4 in
      `CompFor (v1, v2, v3, v4)
  | CompIf (v1, v2) ->
      let v1 = map_tok v1 in
      let v2 = map_expr v2 in
      `CompIf (v1, v2)

and map_field_name = function
  | FN v1 ->
      let v1 = map_name v1 in
      `FN v1
  | FDynamic v1 ->
      let v1 = map_expr v1 in
      `FDynamic v1

and map_entity_name = function
  | EN v1 ->
      let v1 = map_name v1 in
      `EN v1
  | EDynamic v1 ->
      let v1 = map_expr v1 in
      `EDynamic v1
  | EPattern v1 ->
      let v1 = map_pattern v1 in
      `EPattern v1
  | OtherEntity (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherEntity (v1, v2)

and map_literal = function
  | Unit v1 ->
      let v1 = map_tok v1 in
      `Unit v1
  | Bool v1 ->
      let v1 = map_wrap map_of_bool v1 in
      `Bool v1
  | Int v1 ->
      let v1 = map_wrap (map_of_option OCaml.map_of_int64) v1 in
      `Int v1
  | Float v1 ->
      let v1 = map_wrap map_id v1 in
      `Float v1
  | Imag v1 ->
      let v1 = map_wrap map_of_string v1 in
      `Imag v1
  | Ratio v1 ->
      let v1 = map_wrap map_of_string v1 in
      `Ratio v1
  | Atom (v0, v1) ->
      let v0 = map_tok v0 in
      let v1 = map_wrap map_of_string v1 in
      `Atom (v0, v1)
  | Char v1 ->
      let v1 = map_wrap map_of_string v1 in
      `Char v1
  | String v1 ->
      let _, v1, _ = map_bracket (map_wrap map_of_string) v1 in
      `String v1
  | Regexp (v1, v2) ->
      let v1 = map_bracket (map_wrap map_of_string) v1 in
      let v2 = map_of_option (map_wrap map_of_string) v2 in
      `Regexp (v1, v2)
  | Null v1 ->
      let v1 = map_tok v1 in
      `Null v1
  | Undefined v1 ->
      let v1 = map_tok v1 in
      `Undefined v1

and map_const_type = function
  | Cbool -> `Cbool
  | Cint -> `Cint
  | Cstr -> `Cstr
  | Cany -> `Cany

and map_svalue = function
  | Lit v1 ->
      let v1 = map_literal v1 in
      `Lit v1
  | Cst v1 ->
      let v1 = map_const_type v1 in
      `Cst v1
  | Sym v1 ->
      let v1 = map_expr v1 in
      `Sym v1
  | NotCst -> `NotCst

and map_container_operator = function
  | Array -> `Array
  | List -> `List
  | Set -> `Set
  | Dict -> `Dict
  | Tuple -> `Tuple

and map_special x =
  match x with
  | ForOf -> `ForOf
  | Defined -> `Defined
  | This -> `This
  | Super -> `Super
  | Self -> `Self
  | Parent -> `Parent
  | Eval -> `Eval
  | Typeof -> `Typeof
  | Instanceof -> `Instanceof
  | Sizeof -> `Sizeof
  | Spread -> `Spread
  | HashSplat -> `HashSplat
  | NextArrayIndex -> `OtherSpecial "NextArrayIndex"
  | Require -> `Require
  | Op v1 ->
      let v1 = map_arithmetic_operator v1 in
      `Op v1
  | EncodedString v1 ->
      let v1 = map_of_string v1 in
      `EncodedString v1
  | IncrDecr (v1, v2) ->
      let v1 = map_of_incdec v1 and v2 = map_of_prepost v2 in
      `IncrDecr (v1, v2)
  | ConcatString v1 ->
      let v1 = map_of_interpolated_kind v1 in
      `ConcatString v1
  | InterpolatedElement -> `InterpolatedElement

and map_of_interpolated_kind = function
  | InterpolatedConcat -> `InterpolatedConcat
  | SequenceConcat -> `SequenceConcat
  | FString v1 -> `FString v1
  | TaggedTemplateLiteral -> `TaggedTemplateLiteral

and map_of_incdec = function
  | Incr -> `Incr
  | Decr -> `Decr

and map_of_prepost = function
  | Prefix -> `Prefix
  | Postfix -> `Postfix

and map_arithmetic_operator = function
  | Plus -> `Plus
  | Minus -> `Minus
  | Mult -> `Mult
  | Div -> `Div
  | Mod -> `Mod
  | Pow -> `Pow
  | FloorDiv -> `FloorDiv
  | MatMult -> `MatMult
  | LSL -> `LSL
  | LSR -> `LSR
  | ASR -> `ASR
  | BitOr -> `BitOr
  | BitXor -> `BitXor
  | BitAnd -> `BitAnd
  | BitNot -> `BitNot
  | BitClear -> `BitClear
  | And -> `And
  | Or -> `Or
  | Xor -> `Xor
  | Pipe -> `Pipe
  | Not -> `Not
  | Eq -> `Eq
  | NotEq -> `NotEq
  | PhysEq -> `PhysEq
  | NotPhysEq -> `NotPhysEq
  | Lt -> `Lt
  | LtE -> `LtE
  | Gt -> `Gt
  | GtE -> `GtE
  | Cmp -> `Cmp
  | Concat -> `Concat
  | Append -> `Append
  | RegexpMatch -> `RegexpMatch
  | NotMatch -> `NotMatch
  | Range -> `Range
  | RangeInclusive -> `RangeInclusive
  | NotNullPostfix -> `NotNullPostfix
  | Length -> `Length
  | Elvis -> `Elvis
  | Nullish -> `Nullish
  | In -> `In
  | NotIn -> `NotIn
  | Is -> `Is
  | NotIs -> `NotIs
  | Background -> `Background
  | LDA -> `LDA
  | RDA -> `RDA
  | LSA -> `LSA
  | RSA -> `RSA

and map_arguments v = map_bracket (map_of_list map_argument) v

and map_argument = function
  | Arg v1 ->
      let v1 = map_expr v1 in
      `Arg v1
  | ArgType v1 ->
      let v1 = map_type_ v1 in
      `ArgType v1
  | ArgKwd (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_expr v2 in
      `ArgKwd (v1, v2)
  | ArgKwdOptional (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_expr v2 in
      `ArgKwdOptional (v1, v2)
  | OtherArg (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherArg (v1, v2)

and map_type_ { t; t_attrs } =
  let ty = map_type_kind t in
  (* new: *)
  let _attrsTODO = map_of_list map_attribute t_attrs in
  ty

and map_type_kind = function
  | TyEllipsis v1 -> raise (SemgrepConstruct v1)
  | TyRecordAnon (v1, v2) ->
      let v1 = map_wrap map_class_kind v1 in
      let v2 = map_bracket (map_of_list map_field) v2 in
      `TyRecordAnon (v1, v2)
  | TyOr (v1, v2, v3) ->
      let v1 = map_type_ v1 in
      let v2 = map_tok v2 in
      let v3 = map_type_ v3 in
      `TyOr (v1, v2, v3)
  | TyAnd (v1, v2, v3) ->
      let v1 = map_type_ v1 in
      let v2 = map_tok v2 in
      let v3 = map_type_ v3 in
      `TyAnd (v1, v2, v3)
  | TyFun (v1, v2) ->
      let v1 = map_of_list map_parameter v1 and v2 = map_type_ v2 in
      `TyFun (v1, v2)
  | TyApply (v1, v2) ->
      let v1 = map_type_ v1 and v2 = map_type_arguments v2 in
      `TyApply (v1, v2)
  | TyN v1 ->
      let v1 = map_name v1 in
      `TyN v1
  | TyVar v1 ->
      let v1 = map_ident v1 in
      `TyVar v1
  | TyAny v1 ->
      let v1 = map_tok v1 in
      `TyAny v1
  | TyArray (v1, v2) ->
      let v1 = map_bracket (map_of_option map_expr) v1 and v2 = map_type_ v2 in
      `TyArray (v1, v2)
  | TyPointer (t, v1) ->
      let t = map_tok t in
      let v1 = map_type_ v1 in
      `TyPointer (t, v1)
  | TyRef (t, v1) ->
      let t = map_tok t in
      let v1 = map_type_ v1 in
      `TyRef (t, v1)
  | TyTuple v1 ->
      let v1 = map_bracket (map_of_list map_type_) v1 in
      `TyTuple v1
  | TyQuestion (v1, t) ->
      let t = map_tok t in
      let v1 = map_type_ v1 in
      `TyQuestion (v1, t)
  | TyRest (t, v1) ->
      let v1 = map_type_ v1 in
      let t = map_tok t in
      `TyRest (t, v1)
  | TyExpr v1 ->
      let v1 = map_expr v1 in
      `TyExpr v1
  | OtherType (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherType (v1, v2)

and map_type_arguments v = map_bracket (map_of_list map_type_argument) v

and map_type_argument = function
  | TA v1 ->
      let v1 = map_type_ v1 in
      `TA v1
  | TAWildcard (v1, v2) ->
      let v1 = map_tok v1 in
      let v2 =
        map_of_option
          (fun (v1, v2) -> (map_wrap map_of_bool v1, map_type_ v2))
          v2
      in
      `TAWildcard (v1, v2)
  | TAExpr v1 ->
      let v1 = map_expr v1 in
      `TAExpr v1
  | OtherTypeArg (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherTypeArg (v1, v2)

and map_todo_kind (s, tk) =
  let tk = map_tok tk in
  (s, tk)

and map_attribute = function
  | KeywordAttr v1 -> (
      let v1 = map_wrap map_keyword_attribute v1 in
      match v1 with
      | Either.Left v1, tok -> `KeywordAttr (v1, tok)
      | Either.Right s, tok -> `OtherAttribute (s, [ `Tk tok ]))
  | NamedAttr (t, v1, v3) ->
      let t = map_tok t in
      let v1 = map_name v1 and v3 = map_bracket (map_of_list map_argument) v3 in
      `NamedAttr (t, v1, v3)
  | OtherAttribute (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherAttribute (v1, v2)

and map_keyword_attribute = function
  | Static -> Left `Static
  | Volatile -> Left `Volatile
  | Extern -> Left `Extern
  | Public -> Left `Public
  | Private -> Left `Private
  | Protected -> Left `Protected
  | Abstract -> Left `Abstract
  | Final -> Left `Final
  | Override -> Left `Override
  | Var -> Left `Var
  | Let -> Left `Let
  | Mutable -> Left `Mutable
  | Const -> Left `Const
  | Optional -> Left `Optional
  | NotNull -> Left `NotNull
  | Generator -> Left `Generator
  | Async -> Left `Async
  | Recursive -> Left `Recursive
  | MutuallyRecursive -> Left `MutuallyRecursive
  | Inline -> Left `Inline
  | Ctor -> Left `Ctor
  | Dtor -> Left `Dtor
  | Getter -> Left `Getter
  | Setter -> Left `Setter
  | Unsafe -> Left `Unsafe
  | DefaultImpl -> Left `DefaultImpl
  | Throws -> Left `Throws
  | Rethrows -> Left `Rethrows
  | Lazy -> Left `Lazy
  | RecordClass -> Left `RecordClass
  | AnnotationClass -> Left `AnnotationClass
  | EnumClass -> Left `EnumClass
  | SealedClass -> Left `SealedClass

and map_stmt x : B.stmt =
  let skind =
    match x.s with
    | DisjStmt (_v1, _v2) -> raise (SemgrepConstruct fk)
    | ExprStmt (v1, t) ->
        let v1 = map_expr v1 in
        let t = map_tok t in
        `ExprStmt (v1, t)
    | DefStmt v1 ->
        let v1 = map_definition v1 in
        `DefStmt v1
    | DirectiveStmt v1 ->
        let v1 = map_directive v1 in
        `DirectiveStmt v1
    | Block v1 ->
        let v1 = map_bracket (map_of_list map_stmt) v1 in
        `Block v1
    | If (t, v1, v2, v3) ->
        let t = map_tok t in
        let v1 = map_condition v1
        and v2 = map_stmt v2
        and v3 = map_of_option map_stmt v3 in
        `If (t, v1, v2, v3)
    | While (t, v1, v2) ->
        let t = map_tok t in
        let v1 = map_condition v1 and v2 = map_stmt v2 in
        `While (t, v1, v2)
    | DoWhile (t, v1, v2) ->
        let t = map_tok t in
        let v1 = map_stmt v1 and v2 = map_expr v2 in
        `DoWhile (t, v1, v2)
    | For (t, v1, v2) ->
        let t = map_tok t in
        let v1 = map_for_header v1 and v2 = map_stmt v2 in
        `For (t, v1, v2)
    | Switch (v0, v1, v2) ->
        let v0 = map_tok v0 in
        let v1 = map_of_option map_condition v1
        and v2 = map_of_list map_case_and_body v2 in
        `Switch (v0, v1, v2)
    | Return (t, v1, sc) ->
        let t = map_tok t in
        let v1 = map_of_option map_expr v1 in
        let sc = map_tok sc in
        `Return (t, v1, sc)
    | Continue (t, v1, sc) ->
        let t = map_tok t in
        let v1 = map_label_ident v1 in
        let sc = map_tok sc in
        `Continue (t, v1, sc)
    | Break (t, v1, sc) ->
        let t = map_tok t in
        let v1 = map_label_ident v1 in
        let sc = map_tok sc in
        `Break (t, v1, sc)
    | Label (v1, v2) ->
        let v1 = map_label v1 and v2 = map_stmt v2 in
        `Label (v1, v2)
    | Goto (t, v1, _sc) ->
        let t = map_tok t in
        let v1 = map_label v1 in
        `Goto (t, v1)
    | Throw (t, v1, sc) ->
        let t = map_tok t in
        let v1 = map_expr v1 in
        let sc = map_tok sc in
        `Throw (t, v1, sc)
    | Try (t, v1, v2, v3, v4) ->
        let t = map_tok t in
        let v1 = map_stmt v1
        and v2 = map_of_list map_catch v2
        and _v3 = map_of_option map_try_else v3
        and v4 = map_of_option map_finally v4 in
        (* TODO: some languages such as ruby have try-catch-else-finally
         * statements. Support the else block in the atd.
         *)
        `Try (t, v1, v2, v4)
    | WithUsingResource (t, v1, v2) ->
        let t = map_tok t in
        let v1 = map_of_list map_stmt v1 in
        let v2 = map_stmt v2 in
        `WithUsingResource (t, v1, v2)
    | Assert (t, args, sc) ->
        let t = map_tok t in
        let args = map_arguments args in
        let sc = map_tok sc in
        `Assert (t, args, sc)
    | OtherStmtWithStmt (v1, v2, v3) ->
        let v1 = map_other_stmt_with_stmt_operator v1
        and v2 = map_of_list map_any v2
        and v3 = map_stmt v3 in
        `OtherStmt ((v1, map_tok fk), v2 @ [ `S v3 ])
    | OtherStmt (v1, v2) ->
        let v1 = map_other_stmt_operator v1 and v2 = map_of_list map_any v2 in
        `OtherStmt ((v1, map_tok fk), v2)
    | RawStmt x ->
        let first_tok, _last_tok = Raw_tree.unsafe_loc x in
        `OtherStmt (("RawStmt", map_tok first_tok), [])
  in
  skind

and map_other_stmt_operator = function
  | OS_Delete -> "Delete"
  | OS_ForOrElse -> "ForOrElse"
  | OS_WhileOrElse -> "WhileOrElse"
  | OS_TryOrElse -> "TryOrElse"
  | OS_ThrowFrom -> "ThrowFrom"
  | OS_ThrowNothing -> "ThrowNothing"
  | OS_ThrowArgsLocation -> "ThrowArgsLocation"
  | OS_Pass -> "Pass"
  | OS_Async -> "Async"
  | OS_Asm -> "Asm"
  | OS_Go -> "Go"
  | OS_Defer -> "Defer"
  | OS_Fallthrough -> "Fallthrough"
  | OS_GlobalComplex -> "GlobalComplex"
  | OS_Redo -> "Redo"
  | OS_Retry -> "Retry"
  | OS_ExprStmt2 -> "ExprStmt2"
  | OS_Extension -> "Extension"
  | OS_Todo -> "Todo"

and map_other_stmt_with_stmt_operator = function
  | OSWS_With -> "S_With"
  | OSWS_Else_in_try -> "S_Else_in_try"
  | OSWS_Iterator -> "S_Iterator"
  | OSWS_Todo -> "S_Todo"
  | OSWS_Block _TODO -> "S_Todo"
  | OSWS_SEH -> "S_SEH"

and map_condition = function
  | Cond v1 ->
      let v1 = map_expr v1 in
      `Cond v1
  | OtherCond (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherCond (v1, v2)

and map_label_ident = function
  | LNone -> `LNone
  | LId v1 ->
      let v1 = map_label v1 in
      `LId v1
  | LInt v1 ->
      let v1 = map_wrap map_of_int v1 in
      `LInt v1
  | LDynamic v1 ->
      let v1 = map_expr v1 in
      `LDynamic v1

and map_case_and_body = function
  | CasesAndBody (v1, v2) ->
      let v1 = map_of_list map_case v1 and v2 = map_stmt v2 in
      `CasesAndBody (v1, v2)
  | CaseEllipsis v1 -> raise (SemgrepConstruct v1)

and map_case = function
  | OtherCase (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherCase (v1, v2)
  | Case (t, v1) ->
      let t = map_tok t in
      let v1 = map_pattern v1 in
      `Case (t, v1)
  | CaseEqualExpr (t, v1) ->
      let t = map_tok t in
      let v1 = map_expr v1 in
      `CaseEqualExpr (t, v1)
  | Default t ->
      let t = map_tok t in
      `Default t

and map_catch (t, v1, v2) =
  let t = map_tok t in
  let v1 = map_catch_exn v1 and v2 = map_stmt v2 in
  (t, v1, v2)

and map_catch_exn = function
  | CatchPattern v1 ->
      let v1 = map_pattern v1 in
      `CatchPattern v1
  | CatchParam p ->
      let p = map_parameter_classic p in
      `CatchParam p
  | OtherCatch (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherCatch (v1, v2)

and map_try_else v = map_tok_and_stmt v
and map_finally v = map_tok_and_stmt v

and map_tok_and_stmt (t, v) =
  let t = map_tok t in
  let v = map_stmt v in
  (t, v)

and map_label v : B.label = map_ident v

and map_for_header = function
  | ForClassic (v1, v2, v3) ->
      let v1 = map_of_list map_for_var_or_expr v1
      and v2 = map_of_option map_expr v2
      and v3 = map_of_option map_expr v3 in
      `ForClassic (v1, v2, v3)
  | ForEach v1 ->
      let v1 = map_for_each v1 in
      `ForEach v1
  | MultiForEach v1 ->
      let v1 = map_of_list map_multi_for_each v1 in
      `MultiForEach v1
  | ForEllipsis t -> raise (SemgrepConstruct t)

and map_for_each (v1, t, v2) =
  let t = map_tok t in
  let v1 = map_pattern v1 and v2 = map_expr v2 in
  (v1, t, v2)

and map_multi_for_each = function
  | FE v1 ->
      let v1 = map_for_each v1 in
      `FE v1
  | FECond (v1, v2, v3) ->
      let v1 = map_for_each v1 in
      let v2 = map_tok v2 in
      let v3 = map_expr v3 in
      `FECond (v1, v2, v3)
  | FEllipsis tk -> raise (SemgrepConstruct tk)

and map_for_var_or_expr = function
  | ForInitVar (v1, v2) ->
      let v1 = map_entity v1 and v2 = map_variable_definition v2 in
      `ForInitVar (v1, v2)
  | ForInitExpr v1 ->
      let v1 = map_expr v1 in
      `ForInitExpr v1

and map_pattern = function
  | PatEllipsis v1 -> raise (SemgrepConstruct v1)
  | PatRecord v1 ->
      let v1 =
        map_bracket
          (map_of_list (fun (v1, v2) ->
               let v1 = map_dotted_ident v1 and v2 = map_pattern v2 in
               (v1, v2)))
          v1
      in
      `PatRecord v1
  | PatId (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_id_info v2 in
      `PatId (v1, v2)
  | PatLiteral v1 ->
      let v1 = map_literal v1 in
      `PatLiteral v1
  | PatType v1 ->
      let v1 = map_type_ v1 in
      `PatType v1
  | PatConstructor (v1, v2) ->
      let v1 = map_name v1 in
      let v2 = map_of_list map_pattern v2 in
      `PatConstructor (v1, v2)
  | PatTuple v1 ->
      let v1 = map_bracket (map_of_list map_pattern) v1 in
      `PatTuple v1
  | PatList v1 ->
      let v1 = map_bracket (map_of_list map_pattern) v1 in
      `PatList v1
  | PatKeyVal (v1, v2) ->
      let v1 = map_pattern v1 and v2 = map_pattern v2 in
      `PatKeyVal (v1, v2)
  | PatWildcard v1 ->
      let v1 = map_tok v1 in
      `PatWildcard v1
  | PatDisj (v1, v2) ->
      let v1 = map_pattern v1 and v2 = map_pattern v2 in
      `PatDisj (v1, v2)
  | DisjPat (_v1, _v2) -> raise (SemgrepConstruct fk)
  | PatTyped (v1, v2) ->
      let v1 = map_pattern v1 and v2 = map_type_ v2 in
      `PatTyped (v1, v2)
  | PatAs (v1, v2) ->
      let v1 = map_pattern v1
      and v2 =
        match v2 with
        | v1, v2 ->
            let v1 = map_ident v1 and v2 = map_id_info v2 in
            (v1, v2)
      in
      `PatAs (v1, v2)
  | PatWhen (v1, v2) ->
      let v1 = map_pattern v1 and v2 = map_expr v2 in
      `PatWhen (v1, v2)
  | OtherPat (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherPat (v1, v2)

and map_definition (v1, v2) =
  let v1 = map_entity v1 and v2 = map_definition_kind v2 in
  (v1, v2)

and map_entity { G.name = v_name; attrs = v_attrs; tparams = v_tparams } =
  let v_tparams =
    match v_tparams with
    | None -> []
    | Some (_, xs, _) -> map_of_list map_type_parameter xs
  in
  let v_attrs = map_of_list map_attribute v_attrs in
  let v_name = map_entity_name v_name in
  { B.name = v_name; attrs = v_attrs; tparams = v_tparams }

and map_definition_kind = function
  | EnumEntryDef v1 ->
      let v1 = map_enum_entry_def v1 in
      `EnumEntryDef v1
  | FuncDef v1 ->
      let v1 = map_function_definition v1 in
      `FuncDef v1
  | VarDef v1 ->
      let v1 = map_variable_definition v1 in
      `VarDef v1
  | FieldDefColon v1 ->
      let v1 = map_variable_definition v1 in
      `VarDef v1
  | ClassDef v1 ->
      let v1 = map_class_definition v1 in
      `ClassDef v1
  | TypeDef v1 ->
      let v1 = map_type_definition v1 in
      `TypeDef v1
  | ModuleDef v1 ->
      let v1 = map_module_definition v1 in
      `ModuleDef v1
  | MacroDef v1 ->
      let v1 = map_macro_definition v1 in
      `MacroDef v1
  | Signature { sig_tok = _; sig_type } ->
      let v1 = map_type_ sig_type in
      `Signature v1
  | UseOuterDecl v1 ->
      let v1 = map_tok v1 in
      `UseOuterDecl v1
  | OtherDef (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherDef (v1, v2)

and map_enum_entry_def { ee_args; ee_body } =
  let ee_args = map_of_option map_arguments ee_args in
  let ee_body = map_of_option (map_bracket (map_of_list map_field)) ee_body in
  { B.ee_args; ee_body }

and map_module_definition { G.mbody = v_mbody } =
  let v_mbody = map_module_definition_kind v_mbody in
  { B.mbody = v_mbody }

and map_module_definition_kind = function
  | ModuleAlias v1 ->
      let v1 = map_dotted_ident v1 in
      `ModuleAlias v1
  | ModuleStruct (v1, v2) ->
      let v1 = map_of_option map_dotted_ident v1
      and v2 = map_of_list map_item v2 in
      `ModuleStruct (v1, v2)
  | OtherModule (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherModule (v1, v2)

and map_macro_definition
    { G.macroparams = v_macroparams; macrobody = v_macrobody } =
  let v_macrobody = map_of_list map_any v_macrobody in
  let v_macroparams = map_of_list map_ident v_macroparams in
  { B.macroparams = v_macroparams; macrobody = v_macrobody }

and map_type_parameter = function
  | TP v1 ->
      let v1 = map_type_parameter_classic v1 in
      `TP v1
  | TParamEllipsis tk -> raise (SemgrepConstruct tk)
  | OtherTypeParam (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherTypeParam (v1, v2)

and map_type_parameter_classic
    { tp_id; tp_attrs; tp_bounds; tp_default; tp_variance } =
  let tp_id = map_ident tp_id in
  let tp_attrs = map_of_list map_attribute tp_attrs in
  let tp_bounds = map_of_list map_type_ tp_bounds in
  let tp_default = map_of_option map_type_ tp_default in
  let tp_variance = map_of_option (map_wrap map_variance) tp_variance in
  { B.tp_id; tp_attrs; tp_bounds; tp_default; tp_variance }

and map_variance = function
  | Covariant -> `Covariant
  | Contravariant -> `Contravariant

and map_function_kind = function
  | Function -> `Function
  | Method -> `Method
  | LambdaKind -> `LambdaKind
  | Arrow -> `Arrow
  | BlockCases -> `BlockCases

and map_function_definition
    { G.fkind; fparams = v_fparams; frettype = v_frettype; fbody = v_fbody } =
  let fkind = map_wrap map_function_kind fkind in
  let v_fbody = map_function_body v_fbody in
  let v_frettype = map_of_option map_type_ v_frettype in
  let v_fparams = map_parameters v_fparams in
  { B.fkind; fparams = v_fparams; frettype = v_frettype; fbody = v_fbody }

and map_function_body = function
  | FBStmt v1 ->
      let v1 = map_stmt v1 in
      `FBStmt v1
  | FBExpr v1 ->
      let v1 = map_expr v1 in
      `FBExpr v1
  | FBDecl v1 ->
      let v1 = map_tok v1 in
      `FBDecl v1
  | FBNothing -> `FBNothing

and map_parameters (_, v, _) = map_of_list map_parameter v

and map_parameter = function
  | Param v1 ->
      let v1 = map_parameter_classic v1 in
      `ParamClassic v1
  | ParamRest (v0, v1) ->
      let v0 = map_tok v0 in
      let v1 = map_parameter_classic v1 in
      `ParamRest (v0, v1)
  | ParamHashSplat (v0, v1) ->
      let v0 = map_tok v0 in
      let v1 = map_parameter_classic v1 in
      `ParamHashSplat (v0, v1)
  | ParamPattern v1 ->
      let v1 = map_pattern v1 in
      `ParamPattern v1
  | ParamEllipsis v1 -> raise (SemgrepConstruct v1)
  | ParamReceiver v1 ->
      let v1 = map_parameter_classic v1 in
      (* TODO Make a ParamReceiver node *)
      `ParamClassic v1
  | OtherParam (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherParam (v1, v2)

and map_parameter_classic
    {
      G.pname = v_pname;
      pdefault = v_pdefault;
      ptype = v_ptype;
      pattrs = v_pattrs;
      pinfo = v_pinfo;
    } =
  let v_pinfo = map_id_info v_pinfo in
  let v_pattrs = map_of_list map_attribute v_pattrs in
  let v_ptype = map_of_option map_type_ v_ptype in
  let v_pdefault = map_of_option map_expr v_pdefault in
  let v_pname = map_of_option map_ident v_pname in
  {
    B.pname = v_pname;
    pdefault = v_pdefault;
    ptype = v_ptype;
    pattrs = v_pattrs;
    pinfo = v_pinfo;
  }

and map_variable_definition { G.vinit = v_vinit; vtype = v_vtype; vtok = _sc } =
  let v_vtype = map_of_option map_type_ v_vtype in
  let v_vinit = map_of_option map_expr v_vinit in
  { B.vinit = v_vinit; vtype = v_vtype }

and map_field = function
  | F v1 ->
      let v1 = map_stmt v1 in
      `F v1

and map_type_definition { G.tbody = v_tbody } =
  let v_tbody = map_type_definition_kind v_tbody in
  { B.tbody = v_tbody }

and map_type_definition_kind = function
  | AbstractType v1 ->
      let v1 = map_tok v1 in
      `AbstractType v1
  | OrType v1 ->
      let v1 = map_of_list map_or_type_element v1 in
      `OrType v1
  | AndType v1 ->
      let v1 = map_bracket (map_of_list map_field) v1 in
      `AndType v1
  | AliasType v1 ->
      let v1 = map_type_ v1 in
      `AliasType v1
  | NewType v1 ->
      let v1 = map_type_ v1 in
      `NewType v1
  | Exception (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_of_list map_type_ v2 in
      `Exception (v1, v2)
  | OtherTypeKind (v1, v2) ->
      let v1 = map_todo_kind v1 and v2 = map_of_list map_any v2 in
      `OtherTypeKind (v1, v2)

and map_or_type_element = function
  | OrConstructor (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_of_list map_type_ v2 in
      `OrConstructor (v1, v2)
  | OrEnum (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_of_option map_expr v2 in
      `OrEnum (v1, v2)
  | OrUnion (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_type_ v2 in
      `OrUnion (v1, v2)
  (* new: *)
  | OrEllipsis v1 ->
      let v1 = map_tok v1 in
      `OrEnum (("...", v1), None)

and map_class_definition
    {
      G.ckind = v_ckind;
      cextends = v_cextends;
      cimplements = v_cimplements;
      cbody = v_cbody;
      cmixins = v_cmixins;
      cparams = v_cparams;
    } =
  let v_cbody = map_bracket (map_of_list map_field) v_cbody in
  let v_cparams = map_parameters v_cparams in
  let v_cmixins = map_of_list map_type_ v_cmixins in
  let v_cimplements = map_of_list map_type_ v_cimplements in
  let v_cextends = map_of_list map_class_parent v_cextends in
  let v_ckind = map_wrap map_class_kind v_ckind in
  {
    B.ckind = v_ckind;
    cextends = v_cextends;
    cimplements = v_cimplements;
    cbody = v_cbody;
    cmixins = v_cmixins;
    cparams = v_cparams;
  }

and map_class_parent (v1, v2) =
  let v1 = map_type_ v1 in
  let v2 = map_of_option map_arguments v2 in
  (v1, v2)

and map_class_kind = function
  | Class -> `Class
  | Interface -> `Interface
  | Trait -> `Trait
  | Object -> `Object

and map_directive { d; d_attrs } =
  let d = map_directive_kind d in
  (* new: *)
  let _dattrsTODO = map_of_list map_attribute d_attrs in
  d

and map_directive_kind = function
  | ImportFrom (t, v1, v2) ->
      let t = map_tok t in
      let v1 = map_module_name v1 in
      let v2 = map_of_list map_alias v2 in
      `ImportFrom (t, v1, v2)
  | ImportAs (t, v1, v2) ->
      let t = map_tok t in
      let v1 = map_module_name v1
      and v2 = map_of_option map_ident_and_id_info v2 in
      `ImportAs (t, v1, v2)
  | ImportAll (t, v1, v2) ->
      let t = map_tok t in
      let v1 = map_module_name v1 and v2 = map_tok v2 in
      `ImportAll (t, v1, v2)
  | Pragma (v1, v2) ->
      let v1 = map_ident v1 and v2 = map_of_list map_any v2 in
      `Pragma (v1, v2)
  | Package (t, v1) ->
      let t = map_tok t in
      let v1 = map_dotted_ident v1 in
      `Package (t, v1)
  | PackageEnd t ->
      let t = map_tok t in
      `PackageEnd t
  | OtherDirective (v1, v2) ->
      let v1 = map_todo_kind v1 in
      let v2 = map_of_list map_any v2 in
      `OtherDirective (v1, v2)

and map_ident_and_id_info (v1, v2) =
  let v1 = map_ident v1 in
  let v2 = map_id_info v2 in
  (v1, v2)

and map_alias (v1, v2) =
  let v1 = map_ident v1 and v2 = map_of_option map_ident_and_id_info v2 in
  (v1, v2)

and map_item x = map_stmt x
and map_program v = map_of_list map_item v

and map_any x : B.any =
  match x with
  | XmlAt _
  | Raw _
  | Name _
  | Xmls _
  | ForOrIfComp _
  | Ta _ ->
      failwith "TODO"
  | Tp v1 ->
      let v1 = map_type_parameter v1 in
      `Tp v1
  | Cs v1 ->
      let v1 = map_case v1 in
      `Cs v1
  | Ce v1 ->
      let v1 = map_catch_exn v1 in
      `Ce v1
  | Anys v1 ->
      let v1 = map_of_list map_any v1 in
      `Anys v1
  | E v1 ->
      let v1 = map_expr v1 in
      `E v1
  | S v1 ->
      let v1 = map_stmt v1 in
      `S v1
  | Ss v1 ->
      let v1 = map_of_list map_stmt v1 in
      `Anys (v1 |> map_of_list (fun x -> `S x))
  | Flds v1 ->
      let v1 = map_of_list map_field v1 in
      `Anys (v1 |> map_of_list (fun x -> `Fld x))
  | T v1 ->
      let v1 = map_type_ v1 in
      `T v1
  | P v1 ->
      let v1 = map_pattern v1 in
      `P v1
  | At v1 ->
      let v1 = map_attribute v1 in
      `At v1
  | Fld v1 ->
      let v1 = map_field v1 in
      `Fld v1
  | Args v1 ->
      let v1 = map_of_list map_argument v1 in
      `Anys (v1 |> map_of_list (fun x -> `Ar x))
  | Params v1 ->
      let v1 = map_of_list map_parameter v1 in
      `Anys (v1 |> map_of_list (fun x -> `Pa x))
  | I v1 ->
      let v1 = map_ident v1 in
      `I v1
  | Str v1 ->
      let _, v1, _ = map_bracket (map_wrap map_of_string) v1 in
      `Str v1
  | Tk v1 ->
      let v1 = map_tok v1 in
      `Tk v1
  | TodoK v1 ->
      let v1 = map_ident v1 in
      `TodoK v1
  | Modn v1 ->
      let v1 = map_module_name v1 in
      `Modn v1
  | En v1 ->
      let v1 = map_entity v1 in
      `En v1
  | Def v1 ->
      let v1 = map_definition v1 in
      `S (`DefStmt v1)
  | Dir v1 ->
      let v1 = map_directive v1 in
      `S (`DirectiveStmt v1)
  | Di v1 ->
      let v1 = map_dotted_ident v1 in
      `Di v1
  | Pa v1 ->
      let v1 = map_parameter v1 in
      `Pa v1
  | Ar v1 ->
      let v1 = map_argument v1 in
      `Ar v1
  | Pr v1 ->
      let v1 = map_program v1 in
      `Anys (v1 |> map_of_list (fun x -> `S x))
  | Lbli v1 ->
      let v1 = map_label_ident v1 in
      `Lbli v1
  | Dk v1 ->
      let _v1 = map_definition_kind v1 in
      error x
  | Partial _v1 -> error x
  | ModDk v1 ->
      let _v1 = map_module_definition_kind v1 in
      error x

(*****************************************************************************)
(* entry points *)
(*****************************************************************************)

let program x = map_program x
